<%
'######################################################################
'## ab.e.x.asp
'## -------------------------------------------------------------------
'## Feature     :   Extend-X Encryption
'## Version     :   v1.0.1
'## Author      :   Lajox(lajox@19www.com)
'## Update Date :   2012/06/10 22:27
'## Description :   AspBox Extend-X Encryption Block
'######################################################################

Class Cls_AB_E_X

	Private sKey_EncryptChr

	Private Sub Class_Initialize()

	End Sub

	Private Sub Class_Terminate()

	End Sub

	'------------------------------------------------------------------------------------------
	'# AB.E.X.Smp_Encode(s)
	'# @return: string
	'# @dowhat: 简单加密函数
	'# 			适用于任何字符，包括空格和url冲突的"&""?""%"汉字等符号
	'# 			简单加密，可以改造成移位加密，比如每个字符asc码值增加或减少一个数字
	'# 			可以改造成移位随机加密。
	'# 			比如每个字符前有一个随机数字，表示该字符asc码值增加或减少这个随机数字
	'--DESC------------------------------------------------------------------------------------
	'# @param s: [string] (字符串)
	'--DEMO------------------------------------------------------------------------------------
	'# ab.c.print ab.e.x.Smp_Encode("aspbox") '=> 0061007300700062006F0078
	'------------------------------------------------------------------------------------------

	Public Function Smp_Encode(Byval s)
		On Error Resume Next
		Dim Temp,sReturn
		For i=1 to len(s)
			Temp=hex(asc(mid(s,i,1)))
			If len(Temp)=4 then
			   sReturn=sReturn & cstr(Temp)
			Else
			   sReturn=sReturn & "00" & cstr(Temp)
			End If
		Next
		Smp_Encode = sReturn
		On Error Goto 0
	End Function

	'------------------------------------------------------------------------------------------
	'# AB.E.X.Smp_Decode(s)
	'# @return: string
	'# @dowhat: <AB.E.X.Smp_Encode(s)加密算法>的解密函数
	'--DESC------------------------------------------------------------------------------------
	'# @param s: [string] (字符串)
	'--DEMO------------------------------------------------------------------------------------
	'# ab.c.print ab.e.x.Smp_Decode(ab.e.x.Smp_Encode("aspbox")) '=> aspbox
	'------------------------------------------------------------------------------------------

	Public Function Smp_Decode(Byval s)
		On Error Resume Next
		Dim sReturn
		for i=1 to len(s) step 4
			sReturn = sReturn & chr(int("&H" & mid(s,i,4)))
		Next
		Smp_Decode = sReturn
		On Error Goto 0
	End Function

	'------------------------------------------------------------------------------------------
	'# AB.E.X.Smp_Encrypt(s)
	'# @return: string
	'# @dowhat: 简单加密函数
	'--DESC------------------------------------------------------------------------------------
	'# @param s: [string] (字符串)
	'--DEMO------------------------------------------------------------------------------------
	'# ab.c.print ab.e.x.Smp_Encrypt("aspbox") '=> busft~
	'------------------------------------------------------------------------------------------

	Public Function Smp_Encrypt(Byval s)
		Dim temp,i
		For i=1 to Len(s)
			temp = temp & Chr(Asc(mid(s,i,2))+i)
		Next
		Smp_Encrypt = temp
	End Function

	'------------------------------------------------------------------------------------------
	'# AB.E.X.Smp_Decrypt(s)
	'# @return: string
	'# @dowhat: <AB.E.X.Smp_Encrypt(s)加密算法>的解密函数
	'--DESC------------------------------------------------------------------------------------
	'# @param s: [string] (字符串)
	'--DEMO------------------------------------------------------------------------------------
	'# ab.c.print ab.e.x.Smp_Decrypt(ab.e.x.Smp_Encrypt("aspbox")) '=> aspbox
	'------------------------------------------------------------------------------------------

	Public Function Smp_Decrypt(Byval s)
		Dim temp,i
		For i=1 to Len(s)
			temp = temp & Chr(Asc(mid(s,i,2))-i)
		Next
		Smp_Decrypt = temp
	End Function

	'------------------------------------------------------------------------------------------
	'# AB.E.X.NumEncrypt(s)
	'# @return: string
	'# @dowhat: 纯数字加密函数
	'--DESC------------------------------------------------------------------------------------
	'# @param s: [string] (字符串)
	'--DEMO------------------------------------------------------------------------------------
	'# ab.c.print ab.e.x.NumEncrypt(2012) '=> JMORCPGMC
	'------------------------------------------------------------------------------------------

	Public Function NumEncrypt(Byval s)
		On Error Resume Next
		Dim n, szEnc, t, HiN, LoN, i
		n = CDbl((s + 1570) ^ 2 - 7 * (s + 1570) - 450)
		If n < 0 Then szEnc = "R" Else szEnc = "J"
		n = CStr(abs(n))
		For i = 1 To Len(n) step 2
			t = Mid(n, i, 2)
			If Len(t) = 1 Then
				szEnc = szEnc & t
				Exit For
			End If
			HiN = (CInt(t) And 240) / 16
			LoN = CInt(t) And 15
			szEnc = szEnc & Chr(Asc("M") + HiN) & Chr(Asc("C") + LoN)
		Next
		NumEncrypt = szEnc
		On Error Goto 0
	End Function

	'------------------------------------------------------------------------------------------
	'# AB.E.X.NumDecrypt(s)
	'# @return: string
	'# @dowhat: <AB.E.X.NumEncrypt(s)加密算法>的解密函数(纯数字加密解密函数)
	'--DESC------------------------------------------------------------------------------------
	'# @param s: [string] (字符串)
	'--DEMO------------------------------------------------------------------------------------
	'# ab.c.print ab.e.x.(ab.e.x.NumEncrypt(2012)) '=> 2012
	'------------------------------------------------------------------------------------------

	Public Function NumDecrypt(Byval s)
		On Error Resume Next
		Dim e, n, sign, t, HiN, LoN, NewN, i
		e = s
		If Left(e, 1) = "R" Then sign = -1 Else sign = 1
		e = Mid(e, 2)
		NewN = ""
		For i = 1 To Len(e) step 2
			t = Mid(e, i, 2)
			If Asc(t) >= Asc("0") And Asc(t) <= Asc("9") Then
				NewN = NewN & t
				Exit For
			End If
			HiN = Mid(t, 1, 1)
			LoN = Mid(t, 2, 1)
			HiN = (Asc(HiN) - Asc("M")) * 16
			LoN = Asc(LoN) - Asc("C")
			t = CStr(HiN Or LoN)
			If Len(t) = 1 Then t = "0" & t
			NewN = NewN & t
		Next
		e = CDbl(NewN) * sign
		NumDecrypt = CLng((7 + sqr(49 - 4 * (-450 - e))) / 2 - 1570)
		On Error Goto 0
	End Function

	'------------------------------------------------------------------------------------------
	'# 用于产生加密算法 AB.E.X.ChrEncrypt 的定义密匙
	'------------------------------------------------------------------------------------------

	Public Sub ChrEncrypt_GenKey(Byval s)
		IF Not IsNull(s) and s<>"" Then sKey_EncryptChr = s
	End Sub

	'------------------------------------------------------------------------------------------
	'# AB.E.X.ChrEncrypt(s)
	'# @return: string
	'# @dowhat: 简单字符串加密函数
	'--DESC------------------------------------------------------------------------------------
	'# @param s: [string] (字符串)
	'--DEMO------------------------------------------------------------------------------------
	'# ab.c.print AB.E.X.ChrEncrypt("aspbox") '=> %01_O2%0FT
	'------------------------------------------------------------------------------------------

	Public Function ChrEncrypt(Byval s)
		Dim strChar,iKeyChar,iStringChar,iCryptChar,strEncrypted
		Dim I,k : k=0
		sKey_EncryptChr = "96,44,63,80" '定义 ChrEncrypt、ChrDecrypt 的加密/解密密钥
		For I = 1 to Len(s)
			iKeyChar =Cint(Split(sKey_EncryptChr,",")(k))
			iStringChar = Asc(mid(s,I,1)) '获取字符的ASCII码值
			iCryptChar = iKeyChar Xor iStringChar '进行异或运算
			'对密钥进行移位运算
			If k<3 Then
				k=k+1
			Else
				k=0
			End If
			strEncrypted = strEncrypted & Chr(iCryptChar)
		Next
		ChrEncrypt = Escape(strEncrypted)
	End Function

	'------------------------------------------------------------------------------------------
	'# AB.E.X.ChrDecrypt(s)
	'# @return: string
	'# @dowhat: <AB.E.X.ChrEncrypt(s)加密算法>的解密函数
	'--DESC------------------------------------------------------------------------------------
	'# @param s: [string] (字符串)
	'--DEMO------------------------------------------------------------------------------------
	'# ab.c.print AB.E.X.ChrDecrypt(AB.E.X.ChrEncrypt("aspbox")) '=> aspbox
	'------------------------------------------------------------------------------------------

	Public Function ChrDecrypt(Byval s)
		Dim strChar,iKeyChar,iStringChar,iDeCryptChar,strDecrypted
		Dim I,k : k=0
		s = UnEscape(s)
		sKey_EncryptChr = "96,44,63,80" '定义 ChrEncrypt、ChrDecrypt 的加密/解密密钥
		For I = 1 to Len(s)
			iKeyChar =Cint(Split(sKey_EncryptChr,",")(k))
			iStringChar = Asc(mid(s,I,1))
			iDeCryptChar = iKeyChar Xor iStringChar '进行异或运算
			'对密钥进行移位运算
			If k<3 Then
				k=k+1
			Else
				k=0
			End If
			strDecrypted = strDecrypted & Chr(iDeCryptChar)
		Next
		ChrDecrypt = strDecrypted
	End Function

	'------------------------------------------------------------------------------------------
	'# AB.E.X.EnSvCode(s)
	'# @return: string
	'# @dowhat: 简单字符串加密函数
	'--DESC------------------------------------------------------------------------------------
	'# @param s: [string] (字符串)
	'--DEMO------------------------------------------------------------------------------------
	'# ab.c.print AB.E.X.EnSvCode("aspbox") '=> fxugt}
	'------------------------------------------------------------------------------------------

	Public Function EnSvCode(Byval s)
		Dim i
		For i=1 to Len(s)
			If Mid(s,i,1)<>Chr(13) Then
				ven=Asc(Mid(s,i,1))+5
				If ven>127 or ven<33 Then
					ven=ven-95
				End If
				vena=vena&Chr(ven)
			Else
				'vena=vena&"＋"
				vena=vena&"+"
			End If
		Next
		EnSvCode=vena
	End Function

	'------------------------------------------------------------------------------------------
	'# AB.E.X.DeSvCode(s)
	'# @return: string
	'# @dowhat: <AB.E.X.EnSvCode(s)加密算法>的解密函数
	'--DESC------------------------------------------------------------------------------------
	'# @param s: [string] (字符串)
	'--DEMO------------------------------------------------------------------------------------
	'# ab.c.print AB.E.X.DeSvCode(AB.E.X.EnSvCode("aspbox")) '=> aspbox
	'------------------------------------------------------------------------------------------

	Function DeSvCode(Byval s)
		Dim i
		For i=1 To Len(s)
			'If Mid(s,i,1)<>"＋" Then
			If Mid(s,i,1)<>"+" Then
				ven=Asc(Mid(s,i,1))-5
				If ven>126 Then
					ven=ven-95
				ElseIf ven<32 Then
					ven=ven+95
				End If
				vena=vena&Chr(ven)
			Else
				vena=vena&Chr(13)
			End If
		Next
		DeSvCode=vena
	End Function

	'------------------------------------------------------------------------------------------
	'# AB.E.X.spEnc(s)
	'# @return: string
	'# @dowhat: 简单字符串加密函数（只支持英文大小写及数字）
	'--DESC------------------------------------------------------------------------------------
	'# @param s: [string] (字符串)
	'--DEMO------------------------------------------------------------------------------------
	'# ab.c.print AB.E.X.spEnc("aspbox") '=> 68O5MJ
	'------------------------------------------------------------------------------------------

	Function spEnc(Byval s)
		Dim str,key,e,i,li,l(130)
		str="0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
		key="fokuq3FnR2HlcI9CSsL10myrdUpNbh7AjtXa65vQWPwYTZgBEDMOiG8xeVKJz4"
		For i=1 To 130
			If i=32 Then l(i)=" "
			li=instr(str,chr(i))
			If li>0 Then l(i)=Mid(key,li,1)
		Next
		For i=1 To len(s)
			e=e&l(asc(Mid(s,i,1)))
		Next
		spEnc = e
	End Function

	'------------------------------------------------------------------------------------------
	'# AB.E.X.spDec(s)
	'# @return: string
	'# @dowhat: <AB.E.X.spEnc(s)加密算法>的解密函数
	'--DESC------------------------------------------------------------------------------------
	'# @param s: [string] (字符串)
	'--DEMO------------------------------------------------------------------------------------
	'# ab.c.print AB.E.X.spDec(AB.E.X.spEnc("aspbox")) '=> aspbox
	'------------------------------------------------------------------------------------------

	Function spDec(Byval s)
		Dim str,key,e,i,li,l(130):AB.Use "A"
		str="0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
		key="fokuq3FnR2HlcI9CSsL10myrdUpNbh7AjtXa65vQWPwYTZgBEDMOiG8xeVKJz4"
		For i=1 To 130
			If i=32 Then l(i)=" "
			li=instr(str,chr(i))
			If li>0 Then l(i)=Mid(key,li,1)
		Next
		For i=1 To len(s)
			e=e&Chr(ab.a.index(l,Mid(s,i,1)))
		Next
		spDec = e
	End Function

	'------------------------------------------------------------------------------------------
	'# AB.E.X.EncMw(s)
	'# @return: string
	'# @dowhat: 字符串加密函数
	'--DESC------------------------------------------------------------------------------------
	'# @param s: [string] (字符串)
	'--DEMO------------------------------------------------------------------------------------
	'# ab.c.print AB.E.X.EncMw("aspbox") '=> 5213a4792a14656a14679a14682a14664a14667a14681
	'------------------------------------------------------------------------------------------

	Public Function EncMw(ByVal s)
		EncMw=""
		Err.Clear
		On Error Resume Next
		Dim rndChararray,keya,keyb,newStr,temp,bLowChr,bHigChr,Str,i
		rndChararray = "abcdefghijklmnopqrstuvwxyz1234567890"
		randomize
		keya=Mid(rndChararray,int(rnd()*35)+1,1)
		keyb=Mid(rndChararray,int(rnd()*35)+1,1)
		temp=""
		newStr=""
		For i=1 to len(s)
			temp=Mid(s,i,1)
			bLowChr=AscB(MidB(temp, 1, 1)) Xor asc(keya)
			bHigChr=AscB(MidB(temp, 2, 1)) Xor asc(keyb)
			newStr=newStr & ChrB(bLowChr) & ChrB(bHigChr)
		Next
		bLowChr=AscB(MidB(keyb, 1, 1)) Xor 100
		bHigChr=AscB(MidB(keyb, 2, 1)) Xor 20
		keyb=ChrB(bLowChr) & ChrB(bHigChr)
		bLowChr=AscB(MidB(keya, 1, 1)) Xor 128
		bHigChr=AscB(MidB(keya, 2, 1)) Xor 18
		keya=ChrB(bLowChr) & ChrB(bHigChr)
		newStr=keyb & keya & StrReverse(newStr)
		If Err.Number = 0 Then EncMw=EncCk(newStr)
		On Error GoTo 0
	End Function

	'-------------------------------------------------------------------------------------------
	'# AB.E.X.DecMw(s)
	'# @return: string
	'# @dowhat: <AB.E.X.EncMw(s)加密算法>的解密函数
	'--DESC------------------------------------------------------------------------------------
	'# @param s: [string] (字符串)
	'--DEMO------------------------------------------------------------------------------------
	'# ab.c.print AB.E.X.DecMw(AB.E.X.EncMw("aspbox")) '=> aspbox
	'------------------------------------------------------------------------------------------

	Public Function DecMw(ByVal s)
		DecMw=""
		Err.Clear
		On Error Resume Next
		Dim keya,keyb,newStr,temp,bLowChr,bHigChr,Str,i
		s=DecCk(s)
		keya=Mid(s,2,1)
		keyb=Mid(s,1,1)
		bLowChr=ChrB(AscB(MidB(keya, 1, 1)) Xor 128)
		bHigChr=ChrB(AscB(MidB(keya, 2, 1)) Xor 18)
		keya=bLowChr & bHigChr
		bLowChr=ChrB(AscB(MidB(keyb, 1, 1)) Xor 100)
		bHigChr=ChrB(AscB(MidB(keyb, 2, 1)) Xor 20)
		keyb=bLowChr & bHigChr
		Str=StrReverse(Mid(s,3,len(s)))
		newStr=""
		temp=""
		For i=1 to len(Str)
		  temp=Mid(Str,i,1)
		  bLowChr=AscB(MidB(temp, 1, 1)) Xor asc(keya)
		  bHigChr=AscB(MidB(temp, 2, 1)) Xor asc(keyb)
		  newStr=newStr & ChrB(bLowChr) & ChrB(bHigChr)
		Next
		If Err.Number = 0 Then DecMw=newStr
		On Error GoTo 0
	End Function

	'-------------------------------------------------------------------------------------------
	'# AB.E.X.EncCk(s)
	'# @return: string
	'# @dowhat: 字符串加密函数，可用于Cookie读出时防乱码
	'--DESC------------------------------------------------------------------------------------
	'# @param s: [string] (字符串)
	'--DEMO------------------------------------------------------------------------------------
	'# ab.c.print AB.E.X.EncCk("aspbox") '=> 97a115a112a98a111a120
	'------------------------------------------------------------------------------------------

	Public Function EncCk(str)
	  If isNumeric(str) Then str=Cstr(str)
	  Dim newstr : newstr=""
	  For i=1 To Len(str)
		  newstr=newstr & ascw(mid(str,i,1))
		  If i<> Len(str) Then newstr= newstr & "a"
	  Next
	  EncCk=newstr
	End Function

	'-------------------------------------------------------------------------------------------
	'# AB.E.X.DecCk(s)
	'# @return: string
	'# @dowhat: <AB.E.X.EncCk(s)加密算法>的解密函数,可用于Cookie读出时防乱码
	'--DESC------------------------------------------------------------------------------------
	'# @param s: [string] (字符串)
	'--DEMO------------------------------------------------------------------------------------
	'# ab.c.print AB.E.X.DecCk(AB.E.X.EncCk("aspbox")) '=> aspbox
	'------------------------------------------------------------------------------------------

	Public Function DecCk(str)
	  DecCk=""
	  Dim newstr : newstr=Split(str,"a")
	  For i = LBound(newstr) To UBound(newstr)
		  DecCk= DecCk & chrw(newstr(i))
	  Next
	End Function

	'-------------------------------------------------------------------------------------------
	'# AB.E.X.SEnText(StrText, EnType, ListEnText)
	'# @return: string
	'# @dowhat: 位数加1替换法(此函数原理很简单,只是做了简单替换而已)
	'--DESC------------------------------------------------------------------------------------
	'# @param s: [string] (字符串)
	'--------------------------------------
	'StrText 原字符串，即需要加密转换的字符
	'EnType 0-加密 1-解密，也就是一个可逆操作。如果先使用1，那么解密就使用0。
	'ListEnText 加密转换规则，请填写1-9a-z之前不重复数字和字母。
	'按照规则，位数加1替换，如果规则中未涉及的字符将显示原字符。例规则为“321a456”，那么原字符串“1c2a3b”转换后就为ac142b
	'按照这里填写的规则位数加1替换。因为我只需要用到数字和字母，所以只是测试了数字和字母，至于中文能否使用，可以测试一下。
	' 示例说明：
	' 原字字符串：517544292
	' 加密转换规则：973614285
	' 加密转换过程：加1替换。9换7，7换3，3换6，6换1，1换4，4换2，2换8，8换5，5换9
	' 调用函数: AB.E.X.SEnText("517544292", 0, "973614285")
	' 加密后结果：878229349
	' -----------------------
	' 加密后字符串：878229349
	' 解密转换规则：973614285
	' 解密转换过程：减1替换。9换5，7换9，3换7，6换3，1换6，4换1，2换4，8换2，5换8
	' 调用函数: AB.E.X.SEnText("878229349", 1, "973614285")
	' 解密后结果：517544292
	'--DEMO------------------------------------------------------------------------------------
	'# ab.c.printCn AB.E.X.SEnText("517544292", 0, "973614285") '=> 878229349
	'# ab.c.printCn AB.E.X.SEnText("878229349", 1, "973614285") '=> 517544292
	'------------------------------------------------------------------------------------------

	Public Function SEnText(Byval StrText, Byval EnType, Byval ListEnText)
		If StrText="" or IsNull(StrText) Then
			SEnText = StrText
			Exit Function
		End If
		Dim StrEnText, IsShowText, iEnText, MidEnText
		Dim iListEnText, MidListEnText, LenListEnText, GetTextLen
		If ListEnText = "" Then '默认加密转换规则
			ListEnText = "q0nc9w8edaoiuk2mzrfy3xt1p5ls67g4bvhj"
		End If
		StrEnText = ""
		LenListEnText = Len(ListEnText)
		For iEnText = 1 To Len(StrText)
			MidEnText = LCase(Mid(StrText,iEnText,1))
			IsShowText = False
			For iListEnText = 1 To LenListEnText
				MidListEnText = LCase(Mid(ListEnText,iListEnText,1))
				If MidEnText = MidListEnText Then
					IsShowText = True
					GetTextLen = 0
					If EnType = 0 Then'加密
						If iListEnText = LenListEnText Then
							GetTextLen = 1
						Else
							GetTextLen = iListEnText + 1
						End If
					Else'解密
						If iListEnText = 1 Then
							GetTextLen = LenListEnText
						Else
							GetTextLen = iListEnText - 1
						End If
					End If
					StrEnText = Mid(ListEnText,GetTextLen,1) & StrEnText
					Exit For
				End If
			Next
			If IsShowText = False Then
				StrEnText = MidEnText & StrEnText
			End If
		Next
		SEnText = StrEnText
	End Function

	Function PwdConv(Byval s)
		Dim i,ref,value,ltmp
		ltmp=0
		For i = 1 To LenB(s)
			value=AscB(MidB(s,i,1))
			value=(value*i) + 255
			If (ltmp+value)>(&HFF*LenB(s)) Then
				ref=ref & Hex(ltmp)
				ltmp=0
			End If
			ltmp=ltmp + value + Len(Cstr(lTmp))
		Next
		If ltmp>0 Then ref=ref & Hex(ltmp)
		If Mid(ref,1,1)="0" Then ref=Hex(Len(ref)) & ref
		PwdConv= ref
	End Function

	Public Function EnTiFvAz(ByVal c)
		'算法解析：
		'将$－替换成$; %－〉替换成%〉; 将chr(33)至chr(126)分成两部分进行调换; 之外的进行原样输出
		Dim v, i, n
		c = Replace(c, Chr(36) & ChrW(-243), Chr(36))
		c = Replace(c, Chr(37) & ChrW(-243) & Chr(62), Chr(37) & Chr(62))'%->
		For i = 1 To Len(c)
			If i <> n Then
				v = AscW(Mid(c, i, 1))
				If v >= 33 And v <= 79 Then
					EnTiFvAz = EnTiFvAz & Chr(v + 47)
				ElseIf v >= 80 And v <= 126 Then
					EnTiFvAz = EnTiFvAz & Chr(v - 47)
				Else
					n = i + 1
					If Mid(c, n, 1) = "@" Then
						EnTiFvAz = EnTiFvAz & ChrW(v + 5)
					Else
						EnTiFvAz = EnTiFvAz & Mid(c, i, 1)
					End If
				End If
			End If
		Next
	End Function

End Class
%>